home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / QUOSUB.f < prev    next >
Text File  |  1992-07-31  |  3KB  |  101 lines

  1.       SUBROUTINE QUOSUB 
  2. *-----------------------------------------------------------------------
  3. *   
  4. *   Removes {} = string indicators, changes " or ...H to ' if ACTION(11)
  5. *   
  6. *-----------------------------------------------------------------------
  7.       include 'PARAM.h' 
  8.       include 'ALCAZA.h' 
  9.       include 'FLAGS.h' 
  10.       include 'CURSTA.h' 
  11.       include 'STATE.h' 
  12.       include 'JOBSUM.h' 
  13.       CHARACTER *1 STEMP
  14.       NMOD=IMODIF(NSTREF)   
  15.       NCH=0 
  16.       IPT=0 
  17.    10 CONTINUE  
  18.       IF (IPT.EQ.NCHST) GOTO 30 
  19.       IN=INDEX(SSTA(IPT+1:NCHST),'{')   
  20.       IF (IN.EQ.0) GOTO 30  
  21.       L=IN-1
  22.       IN=IPT+IN 
  23.       IF(L.GT.0)  THEN  
  24.          IF (NCH+L.GT.MXLENG) GOTO 40   
  25.          SSTR(NCH+1:NCH+L)=SSTA(IPT+1:IPT+L)
  26.          NCH=NCH+L  
  27.       ENDIF 
  28.       IPT=IN
  29.       IN=INDEX(SSTA(IPT+1:NCHST),'}')   
  30.       L=IN-1
  31.       IN=IPT+IN 
  32.       STEMP=SSTA(IPT+1:IPT+1)   
  33.       IF(STEMP.EQ.''''.OR..NOT.ACTION(11))  THEN
  34.          IF (NCH+L.GT.MXLENG) GOTO 40   
  35.          SSTR(NCH+1:NCH+L)=SSTA(IPT+1:IN-1) 
  36.          NCH=NCH+L  
  37.       ELSE  
  38. *--- replace " or ...H, double up single quotes 
  39.          IF (NMOD.LT.10) NMOD=NMOD+10   
  40.          IF (STEMP.EQ.'"')  THEN
  41.             I1=IPT+2
  42.             I2=IN-2 
  43.          ELSE   
  44. *--- find H 
  45.             I1=IPT+INDEX(SSTA(IPT+1:NCHST),'H')+1   
  46.             I2=IN-1 
  47.          ENDIF  
  48.          NCH=NCH+1  
  49.          IF (NCH.GT.MXLENG) GOTO 40 
  50.          SSTR(NCH:NCH)='''' 
  51.          DO 20 I=I1,I2  
  52.             NCH=NCH+1   
  53.             IF (NCH.GT.MXLENG) GOTO 40  
  54.             STEMP=SSTA(I:I) 
  55.             SSTR(NCH:NCH)=STEMP 
  56.             IF (STEMP.EQ.'''')  THEN
  57.                NCH=NCH+1
  58.                IF (NCH.GT.MXLENG) GOTO 40   
  59.                SSTR(NCH:NCH)=STEMP  
  60.             ENDIF   
  61.    20    CONTINUE   
  62.          IF (IBLPAD.GT.1)  THEN 
  63. *--- blank pad string up to multiple of IBLPAD  
  64.             KPAD=MOD(I2+1-I1,IBLPAD)
  65.             IF (KPAD.GT.0)  THEN
  66.                I=IBLPAD-KPAD
  67.                IF (NCH+I.GT.MXLENG) GOTO 40 
  68.                SSTR(NCH+1:NCH+I)=' '
  69.                NCH=NCH+I
  70.             ENDIF   
  71.          ENDIF  
  72.          NCH=NCH+1  
  73.          IF (NCH.GT.MXLENG) GOTO 40 
  74.          SSTR(NCH:NCH)='''' 
  75.       ENDIF 
  76.       IPT=IN
  77.       GOTO 10   
  78.    30 CONTINUE  
  79. *--- transfer rest and swap if modified 
  80.       IF (IPT.EQ.0) GOTO 999
  81.       L=NCHST-IPT+1 
  82.       IF(L.GT.0)  THEN  
  83.          IF (NCH+L.GT.MXLENG) GOTO 40   
  84.          SSTR(NCH+1:NCH+L)=SSTA(IPT+1:NCHST)
  85.          NCH=NCH+L  
  86.       ENDIF 
  87.       IMODIF(NSTREF)=NMOD   
  88.       SSTA(:NCH)=SSTR(:NCH) 
  89.       NCHST=NCH 
  90.       GOTO 999  
  91.    40 CONTINUE  
  92. *--- error exit - statement too long
  93.       WRITE (MPUNIT,10000)  
  94.       CALL FLPRNT(1,'OVERFLOW',NLLINE(NSTREF)-NFLINE(NSTREF)+1, SIMA
  95.      +(NFLINE(NSTREF)),NDUMMY)  
  96.       NSTATC(6)=NSTATC(6)+1 
  97.       STATUS(11)=.TRUE. 
  98. 10000 FORMAT(/' ++++++ Warning - replacements would lead to overflow',  
  99.      +' in following statement, not done')  
  100.   999 END   
  101.